program queens(inPUT,outPUT);type cl = array[0..8] of integer;var col:cl; i, j, row, QUEEN,N, SOLN :integer; PT, GO, DONE :BOOLEAN;#I D2:POS.Ifunction try(row, queen:integer; col: cl):boolean; var i:integer; tri:boolean;BEGIN i := 1; tri := true; while (i <= queen-1) and tri do begin if col[i] = row then tri := false else if (col[i] = row + queen - i) or (col[i] = ROW - QUEEN + i) then tri := false; i := i + 1 end;TRY := TRIEND;(***********)(* DISPLAY *)(***********)PROCEDURE DISPLAY(COL:CL; SOLN:INTEGER); VAR I:INTEGER;BEGIN WRITELN(CHR(125)); POSITION(20,2); WRITELN('SOLUTION NUMBER: ',SOLN); POSITION(2,0); for i := 1 to 8 do begin writeln('*':col[i]) endend;(***************)(* MAIN LOOP *)(***************)begin WRITELN(CHR(125)); WRITELN('SOLVING THE EIGHT QUEENS PROBLEM'); for j := 0 to 8 do (* initialize the arrays *) col[j] := 0;row := 1;queen := 1;col[queen] := 1;PT := FALSE;SOLN := 0;DONE := FALSE;WHILE NOT DONE DOBEGINwhile (queen <= 8) AND (QUEEN > 0) do begin while (ROW <= 8) and not PT do begin if try(row,queen,col) then begin col[queen] := row; PT := true; end else row := row + 1 end; if not PT then begin row := col[queen - 1] + 1; queen := queen - 1 end else begin row := 1; queen := queen + 1; PT := false; end END;SOLN := SOLN + 1;IF QUEEN > 0THEN DISPLAY(COL,SOLN)ELSE DONE := TRUE;N := 8;GO := FALSE;WHILE (NOT GO) AND (NOT DONE) DOIF COL[N] <> 8THEN BEGIN ROW := COL[N] + 1; QUEEN := N; GO := TRUE ENDELSE N := N - 1END (* NOT DONE *)end.>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
